home *** CD-ROM | disk | FTP | other *** search
- {
- ***
-
- DIR.PAS - an object-oriented file selection facility
- (C)Copyright Gerard Paul Java 1996
-
- }
-
- unit Dir;
-
- interface
- uses Dos;
-
- type
- FileNameStr = string[13];
-
- DirListType = ^DirEntry;
- DirEntry = record
- Name: FileNameStr;
- Prev,Next: DirListType;
- end;
-
- DirObject = object
- DirName: DirStr;
- Mask: FileNameStr;
- DirList: DirListType;
- DirError: boolean;
- procedure Init;
- procedure ReadIn(PathName: PathStr);
- procedure Select(X,Y: byte;
- var FileName: FileNameStr;var Signal: boolean);
- procedure Sort(ListToSort: DirListType);
- procedure Clear;
- end;
-
- implementation
- uses Crt,ScreenRt,SysRt,MenuRt,Error;
-
- procedure DirObject.Init;
- begin
- DirList := nil;
- DirError := False;
- end;
-
- procedure DirObject.ReadIn;
- var
- tNode: DirListType;
- LastNode: DirListType;
- sRec: SearchRec;
- FileName: NameStr;
- FileExt: ExtStr;
-
- Dirs: DirListType;
- LastDir: DirListType;
-
- begin
- Dirs := nil;
-
- FSplit(PathName,DirName,FileName,FileExt);
-
- Mask := FileName+FileExt;
-
- { first build a list of all subdirectories }
-
- FindFirst(DirName+'*.*',Directory,sRec);
- while DosError = 0 do
- begin
- if ((sRec.Attr and Directory) <> 0) and (sRec.Name <> '.')then
- begin
- New(tNode);
- tNode^.Name := sRec.Name+'\';
-
- if Dirs = nil then
- begin
- tNode^.Prev := nil;
- Dirs := tNode;
- end
- else
- begin
- tNode^.Prev := LastDir;
- LastDir^.Next := tNode;
- end;
-
- LastDir := tNode;
- tNode^.Next := nil;
- end;
- FindNext(sRec);
- end;
-
- FindFirst(PathName,Archive+ReadOnly,sRec);
-
- while DosError = 0 do
- begin
- New(tNode);
-
- tNode^.Name := sRec.Name;
-
- if DirList = nil then
- begin
- tNode^.Prev := nil;
- DirList := tNode;
- end
- else
- begin
- LastNode^.Next := tNode;
- tNode^.Prev := LastNode;
- end;
-
- LastNode := tNode;
- tNode^.Next := nil;
-
- FindNext(sRec);
- end;
-
- if (DosError <> 0) and (DosError <> 18) then
- DirError := True;
-
- Sort(DirList);
- Sort(Dirs);
-
- if Dirs <> nil then
- begin
- LastDir^.Next := DirList;
- DirList^.Prev := LastDir;
- DirList := Dirs;
- end;
-
- end;
-
- procedure DirObject.Select;
- var
- tNode,ScrollNode: DirListType;
- Row: byte;
- Keystroke: char;
- TerminateLoop: boolean;
- Ctr: byte;
-
- begin
- if DirError then
- begin
- ErrBox('Unable to read directory','Press a key to continue',Instruct);
- WaitForKeyPress;
- Signal := True;
- end
- else if DirList = nil then
- begin
- ErrBox('No files found','Press a key to continue',Instruct);
- WaitForKeyPress;
- Signal := True;
- end
- else
- begin
- tNode := DirList;
- Row := 1;
-
- TextAttr := BoxAttr;
- DrawBox(X,Y,X+17,Y+10,DoubleLine);Window(X+1,Y+1,X+16,Y+9);
-
- Row := 0;
- TextAttr := OptionNormTextAttr;
-
- repeat
- Inc(Row);
- GotoXY(1,Row);Write(' ',tNode^.Name);
- tNode := tNode^.Next;
- until (Row = 9) or (tNode = nil);
-
- tNode := DirList;
-
- Row := 1;
- TerminateLoop := False;
-
- repeat
- GotoXY(1,Row);TextAttr := OptionSelectedTextAttr;
- Write(' ',tNode^.Name);ClrEol;
- Keystroke := ReadKey;
- GotoXY(1,Row);TextAttr := OptionNormTextAttr;Write(' ',tNode^.Name);ClrEol;
-
- case Keystroke of
- ExtKey: case ReadKey of
- UpKey: begin
- if tNode^.Prev <> nil then
- begin
- if Row = 1 then
- begin
- GotoXY(2,1);InsLine;
- Write(tNode^.Prev^.Name);
- end
- else
- Dec(Row);
-
- tNode := tNode^.Prev;
- end;
- end;
- DownKey: begin
- if tNode^.Next <> nil then
- begin
- if Row = 9 then
- begin
- GotoXY(1,1);DelLine;
- GotoXY(2,9);Write(tNode^.Next^.Name);
- end
- else
- Inc(Row);
-
- tNode := tNode^.Next;
- end;
- end;
- PgDnKey: begin
- ScrollNode := tNode;
-
- { move pointer to end of displayed list }
- if Row < 9 then
- begin
- for Ctr := Row+1 to 9 do
- begin
- ScrollNode := ScrollNode^.Next;
- end;
- end;
-
- if ScrollNode^.Next <> nil then
- begin
- Ctr := 1;
- while (Ctr <= 9) and (ScrollNode^.Next <> nil) do
- begin
- GotoXY(1,1);DelLine;
- GotoXY(2,9);Write(ScrollNode^.Next^.Name);
- tNode := tNode^.Next;
- ScrollNode := ScrollNode^.Next;
- Inc(Ctr);
- end;
- end;
- end;
- PgUpKey: begin
- ScrollNode := tNode;
-
- { move pointer top of displayed list }
- if Row > 1 then
- begin
- for Ctr := Row-1 downto 1 do
- begin
- ScrollNode := ScrollNode^.Prev;
- end;
- end;
-
- if ScrollNode^.Prev <> nil then
- begin
- Ctr := 1;
- while (Ctr <= 9) and (ScrollNode^.Prev <> nil) do
- begin
- GotoXY(1,1);InsLine;
- GotoXY(2,1);Write(ScrollNode^.Prev^.Name);
- tNode := tNode^.Prev;
- ScrollNode := ScrollNode^.Prev;
- Inc(Ctr);
- end;
- end;
- end;
-
-
- end;
- Enter: begin
- TerminateLoop := True;
- Signal := False;
- end;
- Esc: begin
- TerminateLoop := True;
- Signal := True;
- end;
- end;
- until TerminateLoop;
-
- FileName := tNode^.Name;
- end;
- end;
-
- procedure DirObject.Sort;
- var
- tNode1,tNode2: DirListType;
- tName: FileNameStr;
-
- begin
- tNode1 := ListToSort;
-
- while tNode1 <> nil do
- begin
- tNode2 := tNode1^.Next;
- while tNode2 <> nil do
- begin
- if tNode1^.Name > tNode2^.Name then
- begin
- tName := tNode1^.Name;
- tNode1^.Name := tNode2^.Name;
- tNode2^.Name := tName;
- end;
-
- tNode2 := tNode2^.Next;
- end;
-
- tNode1 := tNode1^.Next;
- end;
- end;
-
- procedure DirObject.Clear;
- var
- tNode1: DirListType;
- tNode2: DirListType;
-
- begin
- if DirList <> nil then
- begin
- tNode1 := DirList;
- tNode2 := DirList^.Next;
-
- repeat
- Dispose(tNode1);
- tNode1 := tNode2;
-
- if tNode2 <> nil then
- tNode2 := tNode2^.Next;
- until tNode1 = nil
- end;
- end;
-
-
-
- end.
-